home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
HFTUBE.ZIP
/
TUBERAD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-12-12
|
850b
|
32 lines
Program Test;
Uses Crt;
Var N,M:Word;
R,Xp,Yp,Rad,A,Kx,Ky:Real;
Fil:File;
RadLine:Array[0..511] Of Byte;
Begin
Asm Mov Ax,0013h; Int 10h; End;
Assign(Fil,'TUBE.RAD'); ReWrite(Fil,1);
Mem[$A000:160+100*320]:=1;
R:=128;
For M:=0 to 63 Do Begin
{ R:=128+20*Sin(2*M*Pi/32);}
Xp:={Sin(M*Pi/32)*30}0;
Yp:=Cos(M*Pi/32)*80;
Mem[$A000:Round(160-Xp)+Round(100-Yp)*320]:=15;
For N:=0 to 511 Do Begin
{ R:=130+40*Sin(5*N*Pi/256)*Sin(5*M*Pi/32);}
A:=N*Pi/256; Kx:=Sin(A); Ky:=Cos(A);
Rad:=(-Xp*Kx-Yp*Ky+Sqrt(2*Xp*Kx*Yp*Ky-(Yp*Yp*Kx*Kx+Xp*Xp*Ky*Ky-R*R*Kx*Kx-R*R*Ky*Ky))) / (Kx*Kx+Ky*Ky);
Mem[$A000:Round(160+Kx*Rad)+Round(100+Ky*Rad)*320]:=15;
RadLine[N]:=Round(Rad);
End;
BlockWrite(Fil,RadLine,512);
End;
Close(Fil);
{ Repeat Until KeyPressed;}
Asm Mov Ax,0003h; Int 10h; End;
End.